home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / iguana / vts139b / lib / stmloade.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-31  |  11KB  |  407 lines
  1. UNIT StmLoader;
  2.  
  3. INTERFACE
  4.  
  5. USES Objects, SongUnit;
  6.  
  7.  
  8.  
  9.  
  10. PROCEDURE LoadStmFileFormat(VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  11.  
  12.  
  13.  
  14.  
  15. IMPLEMENTATION
  16.  
  17. USES SongElements, SongUtils, Heaps, AsciiZ;
  18.  
  19.  
  20.  
  21.  
  22. {----------------------------------------------------------------------------}
  23. { Internal definitions. Format of the files.                                 }
  24. {____________________________________________________________________________}
  25.  
  26. TYPE
  27.   TStmFileMagic = ARRAY[1..8] OF CHAR;
  28.  
  29. CONST
  30.   MagicStm : TStmFileMagic = ( '!', 'S', 'c', 'r', 'e', 'a', 'm', '!' );
  31.  
  32. TYPE
  33.  
  34.   TStmInstrument =
  35.     RECORD
  36.       Name      : ARRAY[1..14] OF CHAR;
  37.       fill1     : WORD;
  38.       Size      : WORD;
  39.       RepStart  : WORD;
  40.       RepEnd    : WORD;
  41.       Volume    : WORD;
  42.       NAdj      : WORD;
  43.       fill2     : ARRAY[1..6] OF BYTE;
  44.     END;
  45.  
  46.   TStmHeader =
  47.     RECORD
  48.       Name        : ARRAY[1..20] OF CHAR;
  49.       Magic       : TStmFileMagic;
  50.       fill1       : LONGINT;
  51.       Tempo       : BYTE;
  52.       NPatterns   : BYTE;
  53.       Volume      : BYTE;
  54.       fill2       : ARRAY[1..13]  OF BYTE;
  55.       Instruments : ARRAY[1..31]  OF TStmInstrument;
  56.       Sequence    : ARRAY[1..128] OF BYTE;
  57.     END;
  58.  
  59.   TStmPattern = ARRAY[1..64, 1..4] OF
  60.     RECORD
  61.       b1, b2,
  62.       b3, b4 : BYTE;
  63.     END;
  64.  
  65.  
  66.  
  67.  
  68. PROCEDURE ProcessPatterns(VAR Song: TSong; VAR St: TStream; Num: WORD);
  69.   VAR
  70.     Patt      : TStmPattern;
  71.     FullTrack : TFullTrack;
  72.     Pattern   : PPattern;
  73.     Track     : PTrack;
  74.     c         : BYTE;
  75.     i, j      : WORD;
  76.     n, t      : WORD;
  77.     Row       : WORD;
  78.     Size      : WORD;
  79.     NAdj      : WORD;
  80.     Perd      : WORD;
  81.     l         : LONGINT;
  82.   BEGIN
  83.     t := 1;
  84.     FOR n := 1 TO Num DO
  85.       BEGIN
  86. {WriteLn('Patt ', n : 3, FullHeap.HMaxAvail : 10, FullHeap.HMemAvail : 10);}
  87.         Pattern := Song.GetPattern(n);
  88.         IF Pattern = NIL THEN
  89.           BEGIN
  90.             Song.Status := msOutOfMemory;
  91.             EXIT;
  92.           END;
  93.  
  94.         WITH Pattern^.Patt^ DO
  95.           BEGIN
  96.             NNotes := 64;
  97.             NChans := Song.NumChannels;
  98.             Tempo  := 0;
  99.             BPM    := 0;
  100.           END;
  101.  
  102.         St.Read(Patt, SizeOf(Patt));
  103.  
  104.         IF St.Status <> stOk THEN
  105.           BEGIN
  106.             Song.Status := msFileTooShort;
  107.             EXIT;
  108.           END;
  109.  
  110.         FOR j := 1 TO Song.NumChannels DO
  111.           BEGIN
  112.             FillChar(FullTrack, SizeOf(FullTrack), 0);
  113.  
  114.             FOR i := 1 TO 64 DO
  115.               WITH FullTrack[i-1], Patt[i][j] DO
  116.                 BEGIN
  117.                   FillChar(FullTrack[i-1], SizeOf(FullTrack[0]), 0);
  118.  
  119.                   IF b1 <> $FF THEN
  120.                     BEGIN
  121.                       Period := b1;
  122.                       IF ((Period AND $F0) > $70) OR
  123.                          ((Period AND $F0) < $00) OR
  124.                          ((Period AND $0F) > $0B) THEN
  125.                         Period := 0;
  126.                       Instrument := b2 SHR 3;
  127.                     END;
  128.  
  129.                   Volume := ((b3 AND $F0) SHR 1) + (b2 AND $07);
  130.  
  131.                   IF Volume > 64 THEN
  132.                     Volume := 0
  133.                   ELSE IF Volume < 64 THEN
  134.                     INC(Volume);
  135.  
  136.                   Parameter := b4;
  137.                   CASE b3 AND $F OF
  138.                      0 : Command := mcNone;
  139.                      1 : BEGIN
  140.                            Command   := mcSetTempo;
  141.                            Parameter := b4 SHR 4;
  142.                          END;
  143.                      2 : BEGIN
  144.                            Command := mcJumpPattern;
  145.                            INC(Parameter);
  146.                          END;
  147.                      3 : Command := mcEndPattern;
  148.                      4 : Command := mcVolSlide;
  149.                      5 : Command := mcTPortDown;
  150.                      6 : Command := mcTPortUp;
  151.                      7 : Command := mcNPortamento;
  152.                      8 : Command := mcVibrato;
  153.                     10 : Command := mcArpeggio;
  154.                   ELSE
  155.                     Command := TModCommand(ORD(mcLast) + (b3 AND $F));
  156.                   END;
  157.  
  158.                   IF ((Command = mcEndPattern) OR (Command = mcJumpPattern)) AND
  159.                      (Pattern^.Patt^.NNotes > i) THEN
  160.                     Pattern^.Patt^.NNotes := i;
  161.  
  162.                   IF Period <> 0 THEN
  163.                     BEGIN
  164. {
  165.                       IF (Song.GetInstrument(Instrument)        = NIL) OR
  166.                          (Song.GetInstrument(Instrument)^.Instr = NIL) THEN
  167.                         Dadj := NAdj
  168.                       ELSE
  169.                         DAdj := Song.GetInstrument(Instrument)^.Instr^.DAdj;
  170. }
  171.                       Perd := PeriodSet[(Period SHR 4), Period AND 15];
  172. {
  173.                       IF DAdj > $3E7 THEN
  174.                         ASM
  175.                           MOV     AX,Perd
  176.                           MOV     BX,$20AB
  177.                           MUL     BX
  178.                           MOV     BX,DAdj
  179.                           DIV     BX
  180.                           MOV     Perd,AX
  181.                         END;
  182. }
  183.                       Period := Perd;
  184.                     END;
  185.                 END;
  186.  
  187.             Track := Song.GetTrack(t);
  188.             IF Track = NIL THEN
  189.               BEGIN
  190.                 Song.Status := msOutOfMemory;
  191.                 EXIT;
  192.               END;
  193.  
  194.             Track^.SetFullTrack(FullTrack);
  195.  
  196.             Pattern^.Patt^.Channels[j] := t;
  197.  
  198.             INC(t);
  199.           END;
  200.  
  201.       END;
  202.   END;
  203.  
  204.  
  205. PROCEDURE ProcessInstruments(VAR Song: TSong; VAR St: TStream; VAR Hdr: TStmHeader);
  206.   VAR
  207.     Instrument : TInstrumentRec;
  208.     Instr      : PInstrument;
  209.     i, w       : WORD;
  210.     Signo      : LONGINT;
  211.     NoSigno    : LONGINT;
  212.   BEGIN
  213.     FOR i := 1 TO 31 DO
  214.       WITH Instrument DO
  215.         BEGIN
  216.           FillChar(Instrument, SizeOf(Instrument), 0);
  217.  
  218.           Instr := Song.GetInstrument(i);
  219.           IF Instr = NIL THEN
  220.             BEGIN
  221.               Song.Status := msOutOfMemory;
  222.               EXIT;
  223.             END;
  224.  
  225.           Instr^.SetName(StrASCIIZ(Hdr.Instruments[i].Name, 14));
  226.  
  227.           Len  := Hdr.Instruments[i].Size;
  228.  
  229.           IF Len > 0 THEN
  230.             BEGIN
  231.  
  232.               IF (Hdr.Instruments[i].RepStart <>     0) OR
  233.                  (Hdr.Instruments[i].RepEnd   <> 65535) THEN
  234.                 BEGIN
  235.                   Reps := Hdr.Instruments[i].RepStart;
  236.                   Repl := Hdr.Instruments[i].RepEnd - Reps;
  237.                 END
  238.               ELSE
  239.                 BEGIN
  240.                   Reps := 0;
  241.                   Repl := 0;
  242.                 END;
  243.  
  244.               Vol  := Hdr.Instruments[i].Volume;
  245.               Dadj := Hdr.Instruments[i].Nadj;
  246.               NAdj := $2100;
  247.  
  248.               IF Vol > $40 THEN
  249.                 Vol := $40;
  250.  
  251.               IF Repl        > Len THEN Repl := Len;
  252.               IF Reps + Repl > Len THEN Repl := Len - Reps;
  253.  
  254.               Instr^.Change(@Instrument);
  255.             END
  256.           ELSE
  257.             Instr^.Change(NIL);
  258.         END;
  259.   END;
  260.  
  261.  
  262.  
  263. PROCEDURE ProcessSamples(VAR Song: TSong; VAR St: TStream);
  264.   VAR
  265.     Instr      : PInstrument;
  266.     Instrument : TInstrumentRec;
  267.     i, w       : WORD;
  268.     l          : LONGINT;
  269.   BEGIN
  270.     FOR i := 1 TO 31 DO
  271.       BEGIN
  272. {WriteLn('Instr ', i : 3, FullHeap.HMaxAvail : 10, FullHeap.HMemAvail : 10);}
  273.         Instr := Song.GetInstrument(i);
  274.  
  275.         IF (Instr^.Instr     <> NIL) AND
  276.            (Instr^.Instr^.Len > 0)   THEN
  277.           BEGIN
  278.             Move(Instr^.Instr^, Instrument, SizeOf(Instrument));
  279.             Instr^.FreeContents;
  280.  
  281.             WITH Instrument DO
  282.               BEGIN
  283.  
  284.                 l := St.GetPos;
  285.                 l := St.GetSize - l;
  286.                 IF Len > l THEN
  287.                   BEGIN
  288.                     Song.Status := msFileTooShort;
  289.                     Len := l;
  290.                   END;
  291.  
  292.                 IF Len > 0 THEN
  293.                   BEGIN
  294.                     IF Len <= MaxSample THEN
  295.                       BEGIN
  296.                         FullHeap.HGetMem(POINTER(Data), Len);
  297.                         IF Data = NIL THEN BEGIN
  298.                           Song.Status := msOutOfMemory;
  299.                           EXIT;
  300.                         END;
  301.  
  302.                         St.Read(Data^, Len);
  303.  
  304.                         IF St.Status <> stOk THEN BEGIN
  305.                           Song.Status := msFileDamaged;
  306.                           EXIT;
  307.                         END;
  308.       {
  309.                         FOR w := 0 TO Len - 1 DO
  310.                           INC(Data^[w], 128);
  311.       }
  312.                       END
  313.                     ELSE
  314.                       BEGIN
  315.                         FullHeap.HGetMem(POINTER(Data), MaxSample);
  316.                         FullHeap.HGetMem(POINTER(Xtra), Len-MaxSample);
  317.  
  318.                         IF (Data = NIL) OR (Xtra = NIL) THEN BEGIN
  319.                           Song.Status := msOutOfMemory;
  320.                           EXIT;
  321.                         END;
  322.  
  323.                         St.Read(Data^, MaxSample);
  324.                         St.Read(Xtra^, Len-MaxSample);
  325.  
  326.                         IF St.Status <> 0 THEN BEGIN
  327.                           Song.Status := msFileDamaged;
  328.                           EXIT;
  329.                         END;
  330.                       END;
  331.                   END;
  332.               END;
  333.             Instr^.Change(@Instrument);
  334.           END;
  335.  
  336.         IF LowQuality THEN
  337.           Instr^.Desample;
  338.  
  339.       END;
  340.   END;
  341.  
  342. PROCEDURE LoadStmFileFormat(VAR Song: TSong; VAR St: TStream; VAR Header: TSongHeader);
  343.   VAR
  344.     Hdr        : TStmHeader ABSOLUTE Header;
  345.     InitialPos : LONGINT;
  346.     i          : WORD;
  347.   BEGIN
  348.     Song.FileFormat := mffStm;
  349.  
  350.     InitialPos := St.GetPos;
  351.  
  352.     St.Seek(InitialPos + SizeOf(TStmHeader));
  353.  
  354.     IF Hdr.Magic <> MagicStm THEN
  355.       BEGIN
  356.         Song.Status := msNotLoaded;
  357.         EXIT;
  358.       END;
  359.  
  360.     Song.Status := msOK;
  361.  
  362.     Song.Name := FullHeap.HNewStr(StrAsciiZ(Hdr.Name, 20));
  363.  
  364.     IF Hdr.Volume = 64 THEN
  365.       Hdr.Volume := 63;
  366.  
  367.     Song.FirstTick    := TRUE;
  368.     Song.InitialTempo := Hdr.Tempo SHR 4;
  369.     Song.InitialBPM   := 125;
  370.     Song.Volume       := Hdr.Volume SHL 2;
  371.     Song.NumChannels  := 4;
  372.  
  373.     Song.SequenceLength := 0;
  374.     FOR i := 1 TO 128 DO
  375.       IF Hdr.Sequence[i] < 99 THEN
  376.         Song.SequenceLength := i;
  377.  
  378.     Song.SequenceRepStart := 1;
  379.     Move(Hdr.Sequence, Song.PatternSequence^, Song.SequenceLength);
  380.  
  381.     FOR i := 1 TO Song.SequenceLength DO
  382.       INC(Song.PatternSequence^[i]);
  383.  
  384.  
  385.     { Processing of the instruments }
  386.  
  387.     ProcessInstruments(Song, St, Hdr);
  388.     IF Song.Status > msOk THEN EXIT;
  389.  
  390.  
  391.     { Processing of the patterns (the partiture) }
  392.  
  393.     ProcessPatterns(Song, St, Hdr.NPatterns);
  394.     IF Song.Status > msOk THEN EXIT;
  395.  
  396.  
  397.     { Processing of the samples }
  398.  
  399.     ProcessSamples(Song, St);
  400.     IF Song.Status > msFileTooShort THEN EXIT;
  401.   END;
  402.  
  403.  
  404.  
  405.  
  406. END.
  407.